home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
system
/
pgraf130.zip
/
PASCAL.ZIP
/
DEMO_SUB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-14
|
25KB
|
797 lines
unit demo_sub;
{*******************************************************************
* *
* 'Printer Graphics Interface' Demonstration Program *
* Demonstration Subrotuines Module *
* *
* Main program: DEMO.PAS *
* Author: F van der Hulst *
* *
* Revisions: *
* 27 March 1991: Initial release (Turbo C v2.0 only) *
* 07 April 1991: Ported to MicroSoft C v5.1 *
* 15 October 1991: Rewritten in Turbo-Pascal *
* *
*******************************************************************}
interface
uses graph, pgraph, dos, various;
procedure shapes_demo;
procedure stroked_fonts_demo;
procedure Default_Font_demo;
procedure horiz_text_demo;
procedure vert_text_demo;
procedure text_scaling_demo;
procedure shape_Fill_demo;
procedure flood_Fill_demo;
procedure lines_demo;
procedure pie_demo;
procedure end_slice;
var page_height, page_width: integer; { Size of page in pixels }
var prn: file of char; { Output device }
var screen_echo: boolean;
implementation
const MAX_WIDTH = 801; { Maximum width of any PGRAPH viewport defined in the program }
function min(x, y: integer): integer;
begin
if (x < y)
then min := x
else min := y;
end;
function max(x, y: integer): integer;
begin
if (x > y)
then max := x
else max := y;
end;
var line_num: integer;
var FF: char;
{*******************************************************************
End of outputting a slice to the buffer. Check to see whether it will
fit on the current page. If not skip to the top of the next page }
procedure end_slice;
var
xres, yres: integer;
height: integer;
begin
p_getresolution(xres, yres);
xres := p_getmaxx;
height := p_getmaxy + 1;
line_num := line_num + height;
if (line_num > longint(yres) * page_height div 100) then begin
line_num := height;
write(prn, FF);
end;
if not screen_echo then write('Printing...');
p_print(filerec(prn).handle);
if not screen_echo then writeln;
p_cleardevice;
end;
{********************************************************************
Draw lines, ellipses, polygons, move graphics cursor }
procedure shapes_demo;
var
xasp, yasp: integer;
xres, yres: integer;
error_code: integer;
width, height: integer;
free_space: longint;
arccoords: arccoordstype;
const polypoints: array[0..13] of integer = (
500, 160,
500, 340,
450, 250,
400, 250,
350, 330,
360, 170,
500, 160);
begin
writeln; writeln;
writeln('SHAPES DEMO');
writeln;
p_getresolution(xres, yres);
p_setviewport(0, 0, 0, 0, 0);
free_space := memavail - $4000; { Leave room for other graph memory uses }
width := trunc((longint(xres) * longint(page_width)) / 100);
height := integer(free_space * 8 div width);
height := min(height, integer(longint(yres) * page_height div 100));
writeln('Setting ', width, ' by ', height, ' pixel (', width div xres,
'*', height div yres, ' inches) viewport');
p_setviewport(0, 0, width - 1, height - 1, 0);
error_code := p_graphresult;
if (error_code <> 0) or (height < 340) then writeln('Failed... Insufficient memory')
else begin
p_setlinestyle(4, $8080, 1);
p_rectangle(0, 0, p_getmaxx, p_getmaxy);
p_setlinestyle(2, 0, 1);
writeln('p_drawpoly(7, polypoints);');
p_drawpoly(7, polypoints);
writeln('p_rectangle(220, 140, 270, 10);');
p_rectangle(220, 240, 270, 110);
writeln('p_circle(p_getmaxx - 120, 100, 100);');
p_circle(p_getmaxx - 120, 100, 100);
writeln('p_arc(p_getmaxx - 220, 100, 45, 135, 100);');
p_arc(p_getmaxx - 220, 100, 45, 135, 100);
p_getarccoords(arccoords);
writeln('Last arc centred at (', arccoords.x, ', ', arccoords.y,
'), from (', arccoords.xstart, ', ', arccoords.ystart,
') to (', arccoords.xend, ', ', arccoords.yend, ')');
writeln('p_ellipse(90, 10, 0, 360, 30, 10);');
p_ellipse(90, 10, 0, 360, 30, 10);
writeln('p_ellipse(160, 10, 0, 360, 5, 10);');
p_ellipse(160, 10, 0, 360, 5, 10);
writeln('p_ellipse(200, 10, 45, 135, 30, 10);');
p_ellipse(200, 10, 45, 135, 30, 10);
writeln('p_ellipse(240, 10, 45, 135, 5, 10);');
p_ellipse(240, 10, 45, 135, 5, 10);
writeln('p_ellipse(280, 10, 45, 225, 30, 10);');
p_ellipse(280, 10, 45, 225, 30, 10);
writeln('p_getaspectratio(xasp, yasp);');
writeln('p_setaspectratio(xasp, yasp div 3);');
p_getaspectratio(xasp, yasp);
p_setaspectratio(xasp, yasp div 3);
writeln('Same circle and arc as above, but Ycentre at 390');
p_circle(p_getmaxx - 120, 390, 100);
p_arc(p_getmaxx - 220, 390, 45, 135, 100);
writeln('Width = ', p_getmaxx, ', Height = ', p_getmaxy);
writeln('Current position = (', p_getx, ', ', p_gety, ')');
writeln('p_moveto(40, 50);');
p_moveto(40, 50);
writeln('Current position = (', p_getx, ', ', p_gety, ')');
writeln('p_moverel(+20, -10);');
p_moverel(+20, -10);
writeln('Current position = (', p_getx, ', ', p_gety, ')');
writeln('Various ellipse fragments');
p_ellipse(450, 60, 0, 20, 100, 50);
p_ellipse(450, 60, 30, 60, 100, 50);
p_ellipse(450, 60, 70, 90, 100, 50);
p_ellipse(450, 60, 90, 110, 100, 50);
p_ellipse(450, 60, 120, 150, 100, 50);
p_ellipse(450, 60, 160, 180, 100, 50);
p_ellipse(450, 60, 180, 200, 100, 50);
p_ellipse(450, 60, 210, 240, 100, 50);
p_ellipse(450, 60, 250, 270, 100, 50);
p_ellipse(450, 60, 270, 290, 100, 50);
p_ellipse(450, 60, 300, 330, 100, 50);
p_ellipse(450, 60, 340, 360, 100, 50);
p_ellipse(100, 140, 20, 340, 100, 50);
writeln('Lines');
p_setlinestyle(3, 0, 1);
p_line(100, 140, 200, 140);
p_line(100, 140, 100, 90);
p_line(0, 200, 10, 250);
p_line(0, 200, 50, 210);
p_line(50, 210, 0, 220);
p_line(50, 210, 40, 250);
p_moveto(450, 60);
p_linerel(100, 0);
p_lineto(450, 110);
writeln('Pixels');
p_putpixel(319, 0, 1);
p_putpixel(319, 1, 1);
p_putpixel(319, 1, 0);
end_slice;
end;
end;
{*******************************************************************
Register stroked fonts, and print them in different sizes and
orientations }
procedure stroked_fonts_demo;
var goth_height, next_line: integer;
var errorcode: integer;
begin
writeln; writeln;
writeln('STROKED FONTS DEMO');
writeln;
p_setviewport(0, 0, 719, 170, 0);
errorcode := p_registerbgifont(@Gothic_Font);
if errorcode < 0 then begin
writeln('Couldn''t register Gothic font: ', errorcode);
halt(2);
end;
errorcode := p_registerfarbgifont(@Script_Font_far);
if errorcode < 0 then begin
writeln('Couldn''t register Script font: ', errorcode);
halt(2);
end;
writeln('Printing text size 1, horizontally');
p_settextstyle(GothicFont, HorizDir, 1);
p_outtextxy(0, 0, 'Gothic 1');
goth_height := p_textheight('Gothic 1');
p_settextstyle(ScriptFont, HorizDir, 1);
p_outtextxy(200, 0, 'Script 1');
next_line := max(p_textheight('Script 1'), goth_height);
writeln('Printing text size 1, vertically');
p_settextstyle(GothicFont, VertDir, 1);
p_outtextxy(360, 0, 'Gothic 1');
p_settextstyle(ScriptFont, VertDir, 1);
p_outtextxy(380, 0, 'Script 1');
writeln('Printing text size 2, horizontally');
p_settextstyle(GothicFont, HorizDir, 2);
p_outtextxy(0, next_line, 'Gothic 2');
goth_height := p_textheight('Gothic 2');
p_settextstyle(ScriptFont, HorizDir, 2);
p_outtextxy(200, next_line, 'Script 2');
next_line := next_line + max(p_textheight('Script 2'), goth_height);
writeln('Printing text size 2, vertically');
p_settextstyle(GothicFont, VertDir, 2);
p_outtextxy(410, 0, 'Gothic 2');
p_settextstyle(ScriptFont, VertDir, 2);
p_outtextxy(430, 0, 'Script 2');
writeln('Printing text size 3, horizontally');
p_settextstyle(GothicFont, HorizDir, 3);
p_outtextxy(0, next_line, 'Gothic 3');
goth_height := p_textheight('Gothic 3');
p_settextstyle(ScriptFont, HorizDir, 3);
p_outtextxy(200, next_line, 'Script 3');
next_line := next_line + max(p_textheight('Script 3'), goth_height);
writeln('Printing text size 3, vertically');
p_settextstyle(GothicFont, VertDir, 3);
p_outtextxy(465, 0, 'Gothic 3');
p_settextstyle(ScriptFont, VertDir, 3);
p_outtextxy(500, 0, 'Script 3');
writeln('Printing text size 4, horizontally');
p_settextstyle(GothicFont, HorizDir, 4);
p_outtextxy(0, next_line, 'Gothic 4');
goth_height := p_textheight('Gothic 4');
p_settextstyle(ScriptFont, HorizDir, 4);
p_outtextxy(200, next_line, 'Script 4');
next_line := next_line + max(p_textheight('Script 4'), goth_height);
writeln('Printing text size 4, vertically');
p_settextstyle(GothicFont, VertDir, 4);
p_outtextxy(540, 0, 'Gothic 4');
p_settextstyle(ScriptFont, VertDir, 4);
p_outtextxy(580, 0, 'Script 4');
writeln('Printing text size 5, horizontally');
p_settextstyle(GothicFont, HorizDir, 5);
p_outtextxy(0, next_line, 'Gothic 5');
p_settextstyle(ScriptFont, HorizDir, 5);
p_outtextxy(200, next_line, 'Script 5');
writeln('Printing text size 5, vertically');
p_settextstyle(GothicFont, VertDir, 5);
p_outtextxy(620, 0, 'Gothic 5');
p_settextstyle(ScriptFont, VertDir, 5);
p_outtextxy(660, 0, 'Script 5');
end_slice;
p_setviewport(0, 0, 550, 240, 0);
writeln('Printing text size 9, horizontally');
p_settextstyle(GothicFont, HorizDir, 9);
p_outtextxy(0, 0, 'Gothic 9');
next_line := p_textheight('Gothic 9');
writeln('Printing text size 10, horizontally');
p_settextstyle(GothicFont, HorizDir, 10);
p_outtextxy(0, next_line, 'Gothic 10');
end_slice;
end;
{*******************************************************************
Print default font in various sizes and orientations }
procedure Default_Font_demo;
begin
writeln; writeln;
writeln('DEFAULT FONT DEMO');
writeln;
p_setviewport(0, 0, 680, 199, 0);
writeln('Printing text size 1, horizontally');
p_settextstyle(DefaultFont, HorizDir, 1);
p_outtextxy(0, 0, 'Default 1');
writeln('Printing text size 1, vertically');
p_settextstyle(DefaultFont, VertDir, 1);
p_outtextxy(360, 0, 'Default 1');
writeln('Printing text size 2, horizontally');
p_settextstyle(DefaultFont, HorizDir, 2);
p_outtextxy(0, 18, 'Default 2');
writeln('Printing text size 2, vertically');
p_settextstyle(DefaultFont, VertDir, 2);
p_outtextxy(378, 0, 'Default 2');
writeln('Printing text size 3, horizontally');
p_settextstyle(DefaultFont, HorizDir, 3);
p_outtextxy(0, 40, 'Default 3');
writeln('Printing text size 3, vertically');
p_settextstyle(DefaultFont, VertDir, 3);
p_outtextxy(416, 0, 'Default 3');
writeln('Printing text size 4, horizontally');
p_settextstyle(DefaultFont, HorizDir, 4);
p_outtextxy(0, 65, 'Default 4');
writeln('Printing text size 4, vertically');
p_settextstyle(DefaultFont, VertDir, 4);
p_outtextxy(468, 0, 'Default 4');
writeln('Printing text size 5, horizontally');
p_settextstyle(DefaultFont, HorizDir, 5);
p_outtextxy(0, 100, 'Default 5');
writeln('Printing text size 5, vertically');
p_settextstyle(DefaultFont, VertDir, 5);
p_outtextxy(520, 0, 'Default 5');
writeln('Printing text size 6, horizontally');
p_settextstyle(DefaultFont, HorizDir, 6);
p_outtextxy(0, 150, 'Default 6');
writeln('Printing text size 6, vertically');
p_settextstyle(DefaultFont, VertDir, 6);
p_outtextxy(620, 0, 'Default 6');
end_slice;
p_setviewport(0, 0, 800, 89, 0);
writeln('Printing text size 10, horizontally');
p_settextstyle(DefaultFont, HorizDir, 10);
p_outtextxy(0, 0, 'Default 10');
end_slice;
end;
{*******************************************************************
Print stroked and default font horizontally, using various
justification settings }
procedure horiz_text_demo;
var i: integer;
begin
writeln; writeln; writeln('HORIZONTAL JUSTIFICATION DEMO');
writeln;
p_setviewport(0, 0, 760, 175, 0);
p_setlinestyle(DOTTEDLN, 0, NormWidth);
for i := 1 to 150 div 25 do
p_line(0, i * 25, p_getmaxx, i * 25);
for i := 1 to p_getmaxx div 100 do
p_line( i * 100, 0, i * 100, p_getmaxy);
writeln('Printing Triplex');
p_settextstyle(TriplexFont, HorizDir, 1);
p_settextjustify(LeftText, TopText);
p_outtextxy(100, 50, 'Triplex left top');
p_settextjustify(LeftText, CenterText);
p_outtextxy(300, 50, 'Triplex left centre');
p_settextjustify(LeftText, BottomText);
p_outtextxy(500, 50, 'Triplex left bottom');
p_settextjustify(CenterText, TopText);
p_outtextxy(100, 100, 'Triplex centre top');
p_settextjustify(CenterText, CenterText);
p_outtextxy(300, 100, 'Triplex centre centre');
p_settextjustify(CenterText, BottomText);
p_outtextxy(500, 100, 'Triplex centre bottom');
p_settextjustify(RightText, TopText);
p_outtextxy(100, 150, 'Triplex right top');
p_settextjustify(RightText, CenterText);
p_outtextxy(300, 150, 'Triplex right centre');
p_settextjustify(RightText, BottomText);
p_outtextxy(500, 150, 'Triplex right bottom');
writeln('Printing Default');
p_settextstyle(DefaultFont, HorizDir, 1);
p_settextjustify(LeftText, TopText);
p_outtextxy(200, 25, 'Default left top');
p_settextjustify(LeftText, CenterText);
p_outtextxy(400, 25, 'Default left centre');
p_settextjustify(LeftText, BottomText);
p_outtextxy(600, 25, 'Default left bottom');
p_settextjustify(CenterText, TopText);
p_outtextxy(200, 75, 'Default centre top');
p_settextjustify(CenterText, CenterText);
p_outtextxy(400, 75, 'Default centre centre');
p_settextjustify(CenterText, BottomText);
p_outtextxy(600, 75, 'Default centre bottom');
p_settextjustify(RightText, TopText);
p_outtextxy(200, 125, 'Default right top');
p_settextjustify(RightText, CenterText);
p_outtextxy(400, 125, 'Default right centre');
p_settextjustify(RightText, BottomText);
p_outtextxy(600, 125, 'Default right bottom');
end_slice;
end;
{*******************************************************************
Print stroked and default font vertically, using various
justification settings }
procedure vert_text_demo;
var i: integer;
begin
writeln; writeln;
writeln('VERTICAL JUSTIFICATION DEMO');
writeln;
p_setviewport(0, 0, 642, 180, 0);
p_setlinestyle(DottedLn, 0, NormWidth);
for i := 1 to 150 div 25 do
p_line(0, i * 25, p_getmaxx, i * 25);
for i := 1 to p_getmaxx div 20 do
p_line( i * 20, 0, i * 20, p_getmaxy);
writeln('Printing Triplex');
p_settextstyle(TriplexFont, VertDir, 1);
p_settextjustify(LeftText, TopText);
p_outtextxy(100, 50, 'Triplex left top');
p_settextjustify(LeftText, CenterText);
p_outtextxy(300, 50, 'Triplex left centre');
p_settextjustify(LeftText, BottomText);
p_outtextxy(500, 50, 'Triplex left bottom');
p_settextjustify(CenterText, TopText);
p_outtextxy(120, 100, 'Triplex centre top');
p_settextjustify(CenterText, CenterText);
p_outtextxy(320, 100, 'Triplex centre centre');
p_settextjustify(CenterText, BottomText);
p_outtextxy(520, 100, 'Triplex centre bottom');
p_settextjustify(RightText, TopText);
p_outtextxy(140, 150, 'Triplex right top');
p_settextjustify(RightText, CenterText);
p_outtextxy(340, 150, 'Triplex right centre');
p_settextjustify(RightText, BottomText);
p_outtextxy(540, 150, 'Triplex right bottom');
writeln('Printing Default');
p_settextstyle(DefaultFont, VertDir, 1);
p_settextjustify(LeftText, TopText);
p_outtextxy(200, 25, 'Default left top');
p_settextjustify(LeftText, CenterText);
p_outtextxy(400, 25, 'Default left centre');
p_settextjustify(LeftText, BottomText);
p_outtextxy(600, 25, 'Default left bottom');
p_settextjustify(CenterText, TopText);
p_outtextxy(220, 75, 'Default centre top');
p_settextjustify(CenterText, CenterText);
p_outtextxy(420, 75, 'Default centre centre');
p_settextjustify(CenterText, BottomText);
p_outtextxy(620, 75, 'Default centre bottom');
p_settextjustify(RightText, TopText);
p_outtextxy(240, 125, 'Default right top');
p_settextjustify(RightText, CenterText);
p_outtextxy(440, 125, 'Default right centre');
p_settextjustify(RightText, BottomText);
p_outtextxy(640, 125, 'Default right bottom');
end_slice;
end;
{*******************************************************************
Print stroked font, using various scaling factors }
procedure text_scaling_demo;
var texttypeinfo: textsettingstype;
var lomode, himode: integer;
var x, y: string;
begin
writeln; writeln;
writeln('TEXT SCALING DEMO');
writeln;
writeln('Current graph mode = ', p_getgraphmode);
writeln('Maximum graph mode = ', p_getmaxmode);
writeln('Printer name = ', p_getdrivername);
writeln('Graph mode name = ', p_getmodename(p_getgraphmode));
p_getmoderange(STAR, lomode, himode);
writeln('Star NX-10 mode range = ', lomode, ' -- ', himode);
p_setviewport(0, 0, 660, 190, 0);
p_settextstyle(TriplexFont, VertDir, 1);
p_settextjustify(LeftText, TopText);
p_gettextsettings(texttypeinfo);
write('Text set to font no. ', texttypeinfo.font,
', direction = ');
if texttypeinfo.direction = HorizDir
then write('Horizontal')
else write('Vertical');
writeln(', size = %d', texttypeinfo.charsize);
write('Text justification is ');
if texttypeinfo.horiz = LeftText
then write('Left, ')
else if texttypeinfo.horiz = CenterText
then write('Centre, ')
else write('Right, ');
if texttypeinfo.vert = TopText
then writeln('Top')
else if texttypeinfo.vert = CenterText
then writeln('Centre')
else writeln('Bottom');
p_settextstyle(DefaultFont, HorizDir, 2);
p_settextjustify(CenterText, BottomText);
p_gettextsettings(texttypeinfo);
write('Text set to font no. ', texttypeinfo.font,
', direction = ');
if texttypeinfo.direction = HorizDir
then write('Horizontal')
else write('Vertical');
writeln(', size = %d', texttypeinfo.charsize);
writeln('Text justification is ');
if texttypeinfo.horiz = LeftText
then write('Left, ')
else if texttypeinfo.horiz = CenterText
then write('Centre, ')
else write('Right, ');
if texttypeinfo.vert = TopText
then writeln('Top')
else if texttypeinfo.vert = CenterText
then writeln('Centre')
else writeln('Bottom');
p_setusercharsize(3, 2, 1, 2);
p_settextstyle(TriplexFont, HorizDir, 0);
p_settextjustify(LeftText, TopText);
p_outtextxy(0, 0, 'Treble width, Normal height');
p_setusercharsize(1, 2, 1, 2);
p_outtextxy(0, 15, 'Normal width, Normal height');
p_setusercharsize(1, 2, 3, 2);
p_outtextxy(0, 25, 'Normal width, Treble height');
p_setusercharsize(3, 2, 3, 2);
p_outtextxy(0, 60, 'Treble width, Treble height');
p_setusercharsize(1, 6, 1, 2);
p_outtextxy(0, 110, '1/3 width, Normal height');
p_setusercharsize(1, 2, 1, 6);
p_outtextxy(0, 140, 'Normal width, 1/3 height');
p_setusercharsize(1, 6, 1, 6);
p_outtextxy(0, 170, '1/3 width, 1/3 height');
p_settextstyle(TriplexFont, HorizDir, 1);
writeln('Width, height of ''ABC'' in Triplex size 1 = ',
p_textwidth('ABC'), ', ', p_textheight('ABC'));
p_settextstyle(TriplexFont, HorizDir, 10);
writeln('Width, height of ''ABC'' in Triplex size 10 = ',
p_textwidth('ABC'), ', ', p_textheight('ABC'));
p_settextstyle(DefaultFont, HorizDir, 1);
writeln('Width, height of ''ABC'' in Default size 1 = ',
p_textwidth('ABC'), ', ', p_textheight('ABC'));
p_settextstyle(DefaultFont, HorizDir, 10);
writeln('Width, height of ''ABC'' in Default size 10 = ',
p_textwidth('ABC'), ', ', p_textheight('ABC'));
end_slice;
end;
{*******************************************************************
Fill various shapes with various patterns }
procedure shape_Fill_demo;
const polypoints: array[1..22] of integer = (
500, 10,
500, 190,
450, 100,
400, 100,
350, 180,
360, 20,
400, 20,
420, 70,
370, 100,
450, 20,
500, 10 );
const user_pattern: fillpatterntype = (
$f0, $0f, $f0, $0f, $f0, $0f, $f0, $0f);
var i, xasp, yasp: integer;
fillinfo: fillsettingstype;
var user_pattern2: fillpatterntype;
begin
writeln; writeln;
writeln('SHAPE FILLING DEMO');
writeln;
writeln('Printing in default viewport');
p_graphdefaults;
p_getaspectratio(xasp, yasp);
for i := 0 to 6 do begin
p_setfillstyle(i, 1);
p_getfillsettings(fillinfo);
writeln('Fill style set to ', fillinfo.pattern, ', colour ', fillinfo.color);
p_fillellipse(i * 40 + 20, 20, 20, (longint(20) * xasp) div yasp);
end;
p_setfillpattern(user_pattern, 1);
p_getfillpattern(user_pattern2);
p_getfillsettings(fillinfo);
writeln('Fill style set to ', fillinfo.pattern, ', colour ', fillinfo.color);
p_fillellipse( 7 * 40 + 20, 20, 20, (longint(20) * xasp) div yasp);
p_setfillstyle(LtSlashFill, 1);
writeln('p_fillpoly(11, polypoints);');
p_fillpoly(11, polypoints);
writeln('p_bar(370, 100, 500, 170)');
p_bar(570, 100, 600, 170);
writeln('p_bar3d(0, 100, 50, 150, 25, 1)');
p_bar3d(0, 100, 50, 150, 25, 1);
writeln('p_bar3d(70, 100, 120, 150, 25, 0)');
p_bar3d(70, 100, 120, 150, 25, 0);
end_slice;
end;
{*******************************************************************
Fill an arbitrary shape }
procedure flood_Fill_demo;
const polypoints: array [1..22] of integer = (
200, 10,
200, 190,
150, 100,
100, 100,
50, 180,
60, 20,
100, 20,
120, 70,
70, 100,
150, 20,
200, 10);
begin
writeln; writeln;
writeln('FLOOD FILLING DEMO');
writeln;
p_setviewport(0, 0, 719, 199, 0);
p_setcolor(1);
writeln('Drawing polygon');
p_drawpoly(11, polypoints);
writeln('Including a circle');
p_circle(150, 80, 10);
writeln('Filling polygon');
p_floodfill(165, 80, 1);
end_slice;
end;
{*******************************************************************
Draw various lines in different directions, with a user-defined
pattern }
procedure lines_demo;
var i: integer;
var linetypeinfo: linesettingstype;
begin
writeln; writeln;
writeln('LINE DRAWING DEMO'); writeln;
p_setviewport(0, 0, 719, 199, 0);
p_setlinestyle(UserbitLn, $fc02, ThickWidth);
for i := 0 to 100 div 20 do begin
p_line(0, 0, 100, i * 20);
p_line(319, 0, 200, i * 20);
p_line(i * 20, 199, 100, 100);
p_line(200, 199, 319-(i * 20), 100);
end;
p_getlinesettings(linetypeinfo);
writeln('Current line settings:');
writeln(' Line type = ', linetypeinfo.linestyle);
writeln(' User pattern = ', linetypeinfo.pattern);
writeln(' Thickness = ', linetypeinfo.thickness);
end_slice;
end;
{*******************************************************************
Draw an elliptical pie chart on the printer. }
procedure draw_elliptical_pie;
begin
p_setviewport(0, 0, 500, 120, 0);
p_outtextxy(300, 50, 'Elliptical Pie chart');
p_setlinestyle(SolidLn, 0, NormWidth);
p_setfillstyle(CLOSEDOTFILL, 1);
p_sector(150, 50, 0, 50, 75, 30);
p_setfillstyle(HATCHFILL, 1);
p_sector(150, 50, 50, 120, 75, 30);
p_setfillstyle(XHATCHFILL, 1);
p_sector(150, 50, 120, 190, 75, 30);
p_setfillstyle(WIDEDOTFILL, 1);
p_sector(150, 50, 190, 290, 75, 30);
p_setlinestyle(SOLIDLN, 0, THICKWIDTH);
p_setfillstyle(INTERLEAVEFILL, 1);
p_sector(160, 60, 290, 360, 75, 30);
end;
{*******************************************************************
Draw a circular pie chart on the printer. }
procedure pie_demo;
begin
writeln; writeln;
writeln('PIE CHART DRAWING DEMO'); writeln;
p_setviewport(0, 0, 500, 200, 0);
writeln('Circular pie chart, various fill patterns');
p_outtextxy(300, 100, 'Circular Pie chart');
writeln('Slice 1, CLOSE DOT FILL.');
p_setlinestyle(SolidLn, 0, NormWidth);
p_setfillstyle(CLOSEDOTFill, 1);
p_pieslice(150, 100, 0, 50, 75);
writeln('Slice 2, HATCH FILL.');
p_setfillstyle(HATCHFill, 1);
p_pieslice(150, 100, 50, 120, 75);
writeln('Slice 3, XHATCH FILL.');
p_setfillstyle(XHATCHFill, 1);
p_pieslice(150, 100, 120, 190, 75);
writeln('Slice 4, WIDE DOT FILL.');
p_setfillstyle(WIDEDOTFill, 1);
p_pieslice(150, 100, 190, 290, 75);
writeln('Slice 5, INTERLEAVE FILL.');
p_setlinestyle(SolidLn, 0, THICKWIDTH);
p_setfillstyle(INTERLEAVEFill, 1);
p_pieslice(160, 110, 290, 360, 75);
end_slice;
writeln('Elliptical pie chart, various fill patterns');
draw_elliptical_pie;
end_slice;
end;
begin
line_num := 0;
FF := #$0c;
screen_echo := true;
end.